@L|}6CD l0C)HCC WhL/h `CmCDiD`  R@W1  Y0@R !L` D  C D     )16CS S)  C)D1 p p 0 C9DI pCDL~CiCDiD` D  C D     )16CS S)  C)D1 p p }0 C9DI pCDL~CiCDiD` DD˙` d J)L !}D L(( LL()  L| L( S LH 0p n  } CY?  q  L L  ` )} `A! d߰")-݆ "  $G@LLL&0") $G% }H0 3S8`G ȱG ȱG   Gȭ Gȭ GG}GHiH8(()) G$H% `(0 })8` d)L ݆ & LGȘ ݆LL d  ! LL d)N>Q  HH) }  hyhyB q L> Lm JJ  Ln*` dB%' }8  H H` 1 { LL   !L     Hh SY?  q  1L }  !? S   q 1 L   Ll  Lg E`L   !L)  q 1L}) `L0AM݊L݉ ML  N݆LLLNLMLHG!@}1F GȱGLLEEȩÑEȑEEȑE Ed E7EȩE  q} L !,0,0SGɛ L 1 !L EHEh W G gLLSROTCES EERF } G) *Gȩ GȽG GȌd q q G`  8   0G  `D}CEDC0X:Ȣ Y ȱC* ? 0.. , 0%n ?A[ 0 : L`L  `, 0`Y}`piH n0)բY? 08`0 }  0$L GGȽG L `8L`L}8`  05G)݁,G)ȱGȱGHh0})Hh` B! 8`8iiiLE`}E8FEh( l0`ɃLL L8^~jj8jHi hEEEiEȱEiE` dTE} H8EEȱEEȩEh J E8   . m  i`LI!)E1FR}1LJ舩9GIH`LJJ`HGHh l`} S gL   8 rii `дCDCG W  }C  Lq` X٨`DOS SYS IIIIIIIIIIIIIIIC`0 ߩ0}}}RE |||DDOS DOSDOS SYS }}}}.}CDOS SYS} 0`BDELV !B }`LVUQ   ]   TU J ]L!T  #      TU  } L ? .  t`GBJ V~DEHI B V0dV!}QDEHI VF9 ,0 ,0 s0hhL  L` H hDHEh"}DEL8HI   0 HI,0 0  9 .G VLO#},0 L4*IJ`llD1:AUTORUN.SYSNEED MEM.SAV TO LOAD THIS FILE.D1:MEM.SAV J y08 B|DEHI$} V0 0`B;DELV䌚 !B y`@ʆ v s? F0Ξ05: [ BDEHI%} VY8 B V  @  /DE `E:D1:DUP.SYSERROR-SAVING USER MEMORY ON DISKTYPE Y TO &}STILL RUN DOS B;DE J V (` 9 V⪍ ઍ  -'}LLu DEHILV 9 .l 9 .l  `` s$B VBH(}I|DE V BLV nB,DE J V* \*` B V BLVDEHI BLVL)}1u H232435; 1 ;  hh@2 e1i1LHҍ 00) 08 109hh@ Ҡ2e*}1i1232435ޥ<<8} 3E:}DISK OPERATING SYSTEM II VERSION 2.0SCOPYRIGHT 1980 ATARIA. DISK DIRECTORY I. FORMAT DISKB. RUN CARTRIDGE J. D,}UPLICATE DISKC. COPY FILE K. BINARY SAVED. DELETE FILE(S) L. BINARY LOADE. RENAME FILE M. RUN AT ADDRESSF. LOCK F-}ILE N. CREATE MEM.SAVG. UNLOCK FILE O. DUPLICATE FILEH. WRITE DOS FILES9!&x#!7&p))'&X*./)L''-؆莟.}R'S  vW DEHHI 1A#! @ ~0ɛ8A0.) ȅ 1 1i/}il ! 1L NO SUCH ITEMSELECT ITEM OR FOR MENU! 0 .{z:*{}.|~ 1 0 00}JB 18L^%|DLl%DIRECTORY--SEARCH SPEC,LIST FILE? # 0 0 n&|D! 1L NOT A DISK FILE1}N !B 1L " 1 !BDED:}:1BJ|DE 1DEBH2}I 1 h0ߢ 0.  0?詛 1 ~0YЛ 1 "L<" "L 3} BL1TYPE "Y" TO DELETE...DELETE FILE SPECCOPY--FROM, TO?OPTION NOT ALLOWED 158 FREE SECTORS COPYING---D2:PRIN4}TEROC# 0|D .L$A#B#C#JB|DE 1BHIDD#E 1D#0: B5} 1L B#C#C#B# B 1N#$0SYS1}:e#D# d# D# .d#ȽD# d# 𩛙d#X# 1,A#6}PdD#ELO- A.BJdD#E 1 1HH 0hh|DL^%1}:e# Lt% e#dD#EL%7} 1 0 . .0% 1L WILD CARDS NOT ALLOWED IN DESTINATION 0 A.|K@C}//3Hu ξL/L DRIVE TO WRITE DOS FILES TO?WRITING NEW DOS FILESTYPE "Y" TO WRITE DOS TO DRIVE 2.?}D2:DOS.SYSERROR - NOT VERSION 2 FORMAT. , &* բ( 1L `[) 0NΞ 0 L1M) 1@} L BAD LOAD FILELOAD FROM WHAT FILE?) 0 0#B 1L WHAT FILE TO LOCK?) 0 0$B 1L WHAT FILE TO UNLOCK?DUA}P DISK-SOURCE,DEST DRIVES?TYPE "Y" IF OK TO USE PROGRAM AREACAUTION: A "Y" INVALIDATES MEM.SAV. h  ,B}  `)  <0 2 2 0  ,   ,,ޢ* 1L ,K* 1 ~0 0C}FINSERT BOTH DISKS, TYPE RETURNERROR - DRIVES INCOMPATIBLE., 1 ~038  , 1L D}, &*  Lz+, 0 , 1 ~0 + Y,0!,0 ,L+ ,mm  v,"ǭE}0Ξ, 05,Lt+L +,Hh` NOT ENOUGH ROOMINSERT SOURCE DISK,TYPE RETURNF}INSERT DESTINATION DISK,TYPE RETURN`    `L,8,0( rG}L1(`ߢ) 1* 1 ~0Y`hhL S SL1) 8`NAME OF FILE TO MOVE?- 0 0|DLtH}% A., 1 <0 0 .@L# .BJ 1  DEHIB V L1 ,5 1 <0,L. I} JB|,A#Pd#DE 1 HI BDEHHII 1 B 1 , 1 <0,0Lf- B VJ},A#P, 1 <0 0L#L ߢ) 1* 1 ~0Yj383}mm ݭK}}`8}``|* ? ɛ,`|:(|/ 1L `DESTINATION CANT L}BE DOS.SYS0 0H{ $22Δ $28/L /) $2 Π $2 0 ξM}hAΞB,0 J 1 BޝDEHI,HDE 1HIHIDELSAVE-N}GIVE FILE,START,END(,INIT,RUN)O X0 1`BDEPHI V` X0H 1 L O}0 0 1L0`PLEASE TYPE 1 LETTER,0`hhL <0 1L0LA1 ,;ɛ7,"ɛ:ݦ1ݥP}A"D|ݤD|ȩ:|ȩ|ɛ,,(/+.ީ1 1,ɛ`轤{Q}NAME TOO LONG B VL ` L1I H1EӝDL1|mDiE` V0`8d/8 i:"2!22 1R} L ERROR- 144ɛ+,' 20*.. өw2 1``2TOO MANY DIGITSINVALIDS} HEXADECIMAL PARAMETER800 0 8 00`,0'D800H,ɛh`2L1NEED D1 THRU D4uT} HEXADECIMAL PARAMETER800 0 8 00`,0'D800H,ɛh`2L1NEED D1 THRU D4uMTT5lBNDEJK V0 = =M =0 L B V LUlH =H =H =IhV}HhEhD8HDHIEIHI V`BHI V`D:*.IN/ =0 L B V LUlH =H =H =IhI8K8P?@     Y`  Y0 l `8 B V LUlH =H =H =Ih X@A cP ` `Lx8LLoLjLxLyLHHGhY}h`HHGhh` L L c" L L! L c LJɛI ƴH h Z}洠`H hH)_ h)} ~L IJ Ȅ    [}д` Ъ!B(Ciim@@m?@?@mC@C@mP@P@mS@S@mV@V@mY@Y@m\@\@m_@_@mb@b@m\}l@l@mo@o@m@@m@@m@@m@@mN@N@m9@9@m;@;@m$C$C +@ ,@ i!.@ i3@C C C@]}A &C.@3@)`l!B ` `Lx8LLoLjLxLyLHHGh(83rD:SYSTEM.4TH $0<HT`lx+7 CO[g  % _}`} D:TURNKEY.4TH @S$qa}0u <8L4>űǕǕ LB<HǕhj}˔ǕLB<(EMIT>gPEMI~>A>>@CKPRF̉>A>uA< *BKEٴ>P?TERMINA>P(CR>PC>Ak}<>A>@CMOV>> <LB<ƑL?U>!?”Ô666uuuLB@8@HHLB@-DUeDA6A<6A@TRAVERSuDAAA@<AA.D<AA@LATESԈDAQCuAuA@LFw}DA<C@CFDAfBC@NFDA<C(<<A@-TRAILINǝFA6AVBb=AA@^BCAwBC<@<^BC<@(."FAY@F6ACH@@6@F@.FA<"\CuA<EG{HCA|}CC< {HCFF@EXPECGAA@Ab=X6A<BuAC<A<~A{=CH@fBC@6@<'6A<A}}@QUERGGABuA@ERAS~} HAVBH@BLANK)HAwBH@HOL9HA(C<"BHCEAAC}6@Y@CA@CCH@>@UPPEtHAA@Ab={=AL@ERROIABuA@<ICFFG ? O?AACuACuAL@IDIAiH< <_H6ADDAC}iHA>iHF<?AA@^BC6AA<?AAFmD@CREATJACXuAC<@ DfB EI<AD J<OmDC6AABuAHMCC6AG9K\CuAo@<GOK<@ABORLAe FN>Gfig-FORTH 1.0DKKLCOL6LhLL D L L < LS->_LA6A@@@+LA@<@}@D+MA@<@@ABMA6AM@DAB%MA6AM@MI3MAAAKD<AA@MABMAAA.D<AA@MZMAAA?6@+MA+M?H@M}@MrMAA6@6@:MY@+MW?H@Y@?MAH@MA@MA?A@/MOĶMA6@LH@M@MAMAA@MOMAMA@*/MOMA6@wMH@M@*M}AMAA@M/MONA6@VBY@W?H@A6@W?H@@USN*B*PRE2N*B(+BU6A+CAGSCR # `S<VBb=>{=nBPSmD{=+CuAO<>@INDEtSA>CAb=>{=nBPSmDVB{=O><@<>>@}TRIAijSAnBMnBMnBA@Ab=>{={S<><O>>>@VLISSA<"CADCuAuA"CuABKD< >VB"CA6A JmDmDDDuA6Ao@>?<A}@PICTnT eѨLB6A<~CA@FREYYACXuAiH(<@C@UjYAVBAS@NEW-ABORԃYACfBC(<@L6AuACA@*$Y*B(P:Y}YP:PYBYPR-OYA(A@PR-OFYA(A@PLISYACA(< >>b=>{={S>>>><@<}(< >>@:SELECZAOFC^BCVBwB{HCCA(<;C<4CCBIACI< ADC<CFFG UNDEFINEDL<AA_F6A6AAnBM@CA}Cb={=A6Ao@<A{=CuA<@<AC< {=CuA<@nB+=@DUMJZAfCuA6@EVBb=>6A{=@6AVB(<SG:(<VBb=6A{=@AfBPSmD<}^B(<A(<VBb=6A{=@A><><@VB(<AA(<+=A>H@fCA@VB(<A@XI^}A(<lT6@Y@(@$STORŮ`A`HM6@}`CAY@>H@`@$VARLE`A^BCA@$VARMA`A}fBCA@$ aA6Aa`@$aA6A6Aa`A^BCA@$-aA}`C`F`@$DUFaA}`C``@$P2YaA}``@C@$LENlaAsaA@$OV}EaAsaCa`@$SWAЏaA}`6@`a`@C}`AY@A[H@c`A@$aAaa`@}`C6AC`[^Bc`EA}`A@$FILaAAC}`AC6Ac`AnB}lTAACYDYDH@$VARFILaAA6AaAaC|D<6@A#aH@Aaa2a<AA@$VARIABL bAOF6ACVBCC_FC@("YbAY@C#aY@AH@}@C6@@ybA\CuA<Eb(<"{HCACC<(<"{HCC#a@$EO̕bkFub$FILbAb#aa}`C@$SETDRbA~OXbA6Y(<`A}@$SETDRbA~OYbADY(<`A@$T c*B($COMPARE+cAVB1cA|D<8VBb=A{=@AA{=@AC|D<@< (<<^B1cA@<}AA1cuA@($BLCOMPARE5cAVB1cA|D<2VBb=6A{=@AwBC|D<@< (<<^B1cA@<A1cuA@$COMPARŐcAsaC}`C`aHMBc6A}o@<6`a.D<AsaC`@a`Cc<A}`Ca@`aCc@``@$cAco@@$DdAc@@"QdA(^BfAfBVB\+CuAnBPSGgG(<VBb=fB{=C\{=fBPSG |6A(< F(< @G|<A(<}(<\GgG(<(<\G|(<&(<\G|(<(<\GgGyf(< BHfB(<\G$EIT BORT OPY RASE EARCH VBf}A(<^B\@EDUgA[A^BC6Ao@<A(<[A@EDDOWhA[AC6A(<C<A^B[A@EDLEFiA \uA^BC6A(<C<A(<%} \A@EDRIGH>iA \uAC6A(<&C<A(< \A@EDINSLINiiA[A^BC6@Y@^BC(<b={=Hg{=CHg(< >{=Cug(<+=Y@Hg(< BHY}@ug(<H@C\wN@EDDELLINœiA[A^BC6@(<Y@b={=CHg{=Hg(< >{=ug(<@wBAAAug(<@ \AC[AwN@EDSCREEXkkFZh iGi}si~jjiidkj}jjjjjNjEDEXIԺkAA(<}>~O^B@EDABORkACNuAuA(<?CNuAAl@EDNEXlAAAA^B+CEAh(<}^BVB@EDPRE5lAAAA(<+CEAh(<^BVB@EDERASXlAAAAVBHgBBHyfBBH(<VBb={=ug(<~>^BC<`YVB6A(<0.DA(<9KD?<A`Y(<>VB< AACVB@EDGETN}U͹lA6A< iHAl<AiHVBo@< Xl<6AiHC< AVBVB<"VBAiHb=(< M{=A(<0C@<^B@EDNEDmAfB(<\Gscreen: }Om<+CAhAA(<^B<AfB(<\(<RVB@EDCOP٫mAA+CuAfB(<\Gfrom:VBOmAVBKD?<(< (<\Gto:VBOmAVBKD?<}(<(<\Gscreens:VBOmAVBKD?<~nBlTnBlTKD<*VBb=A{=@OA{=@7CuA@NB>wN<<>6@Y@@^BCAY@@^BCAH@VBb=A{=}COA{=C7CuA@NB>wN<AA~O<AAA<AA<A+CAhVB@EDSEARCmAAVB@EDMENUSEokFZXlAlCmElSo>>luAVB>A FVB\A+CAhVB(<}W>6A(<C<^BfAkAVBfA<AKo<>A@ADDBLKӖoAA~O<Y[(< VBDY<X[(< VB6Y9VT^BN6A(<BHAVBb=[A}(<oWT<A[oVN@DOoBDIOpA[oV[(<VBb9V`>T[iH(< W|D<TiHAF<[oVT@LOCYpA[oV(<#[VBVBb'^}`T@UNLOC˛pA[oV(<$[VBVBb'^`T@DELETżpA[oV( <8L4>űǕ}Ǖ LB<HǕh˔ǕLB<(EMIT>gPEMI~>A>>@CKPRF̉>A>uA< }*BKEٴ>P?TERMINA>P(CR>PC>A<>A>@CMOV>> <LB<ƑL?U>!?”Ô666}uuuLB}@8@HHLB@-DUeDA6A<6A@TRAVERSuDAAA}@<AA.D<AA@LATESԈDAQCuAuA@LFDA<C@CFDAfBC@NFDA<C(<<A@-TRAILINǝFA6AVBb=AA@^BCAwBC<@<^BC<@(."FAY@}F6ACH@@6@F@.FA<"\CuA<EG{HCACC< {HCFF@EXPECGAA@Ab=X6A<BuAC<A<~A{=CH@fBC@6@<'6A}<A@QUERGGABuA@ERAS HAVBH@BLANK)HAwBH@HOL9HA(C<"BHCEAAC6@Y@CA@CCH@>@UPPEtHAA@Ab={=AL@ERROIABuA@<ICFFG ? O?}AACuACuAL@IDIAiH< <_H6ADDACiHA>iHF<?AA@^BC6AA<?AAFmD@CREATJACXuAC<@ DfB EI<AD} J<OmDC6AABuAHMCC6AG9K\CuAo@<GOK<@ABORLA? FN>Gfig-FORTH 1.0DKKLCOL6LhL}L D L L < LS->_LA6A@@@+LA@<@@D+MA@<@@ABMA6AM@DAB%MA6AM@MI3MAAAKD<AA@MABMA}AA.D<AA@MZMAAA?6@+MA+M?H@M@MrMAA6@6@:MY@+MW?H@Y@?MAH@MA@MA?A@/MOĶMA6@LH@M@MAMA}A@MOMAMA@*/MOMA6@wMH@M@*MAMAA@M/MONA6@VBY@W?H@A6@W?H@@USN*B(PRE2N*B(+BU6A+CAGSCR # `S<VBb=>{=nBPSmD{=+CuAO<>@INDEtS}A>CAb=>{=nBPSmDVB{=O><@<>>@TRIAijSAnBMnBMnBA@Ab=>{={S<><O>>>@VLISSA<"CADCuAuA"CuAB}KD< >VB"CA6A JmDmDDDuA6Ao@>?<A@PICTnT eѨLB6A<~CA( FORTH DOS: ) CR ." DELETE filespec -$> " CR ." DIR filespec -$> " CR ." FORGET DOS " CR } ." LOCK filespec -$> " CR ." RENAME D*:file,file -$> " CR ." SCRCOPY strt end --> " ." filespec -$> " }CR ." UNLOCK filespec -$> " CR HEX 0 CONSTANT DOS --> } } : DIR #4 CLOSE #4 6 0 $FILE OPEN $DROP CR ?DISKERROR BEGIN #4 PAD 20} GETREC -DUP WHILE ( loop until 0 len) ?DISKERROR PAD SWAP TYPE REPEAT #4 CLOSE ?DISKERROR ; : LOCK } #4 CLOSE 23 #4 0 0 $FILE XIO $DROP ?DISKERROR ; : UNLOCK #4 CLOSE }24 #4 0 0 $FILE XIO $DROP ?DISKERROR ; : DELETE #4 CLOSE 21 #4 0 0 $FILE XIO $DROP ?}DISKERROR ; -->: SCRCOPY ( copy scr to new fil) #4 CLOSE #4 8 0 $FILE OPEN $DROP ?DISKERROR 1+ S}WAP DO ( 1 scr per loop) #4 I BLOCK 200 PUTBUF ?DISKERROR LOOP #4 CLOSE ?DISKERROR ; : }RENAME #4 CLOSE 20 #4 0 0 $FILE XIO $DROP ?DISKERROR ; } } DECIMAL ELETE filespec -$> " CR ." DIR filespec -$> " CR ." FORGET DOS " CR $( DISK HANDLER INTERFACE ) HEX CREATE DSKINV 8A C, 48 C, ( TXA PHA ) 20 C, E453 , ( jsr dskinv ) ! } 68 C, AA C, ( PLA TAX ) 4C C, 3C42 , ( jmp NEXT ) SMUDGE 300 CONSTANT DDEVIC !!} 301 CONSTANT DUNIT 302 CONSTANT DCOMND 303 CONSTANT DSTATS 304 CONSTANT DBUF !"} 306 CONSTANT DTIM 308 CONSTANT DBYT 30A CONSTANT DAUX1 30B CONSTANT DAUX2 !#} -->: GETSECTOR ( drive# bufadr sector --> status ) DAUX1 ! DBUF ! DUNIT C! 52 DCOMND C! DS!$}KINV DSTATS C@ ; : PUTSECTOR ( drive# bufadr sector --> s!%}tatus ) DAUX1 ! DBUF ! DUNIT C! 57 DCOMND C! DSKINV DSTATS C@ ; !&} !'} -->: DMP ( sector --> ) CR CR ." sector " DUP . >R 2 8000 R> GETSECTOR ." s!(}tatus=" . CR 8000 80 DUMP CR ; 8000 CONSTANT BUF DECIMAL : COPY CR .!)}" Put SOURCE in drive 1" CR ." Put DEST. in drive 2" CR ." Hit key when ready" KEY DROP CR 721 1 DO I . ." R=" !*} 1 BUF I GETSECTOR . ." W=" 2 BUF I PUTSECTOR . CR LOOP ." DONE" BELL CR ; !+} -->: S1 ( filespec -$> ) $SETDR1 DR1 ; !,} : DOS.FILE ( filespec -$> ) #3 8 0 $FILE OPEN #3 CLOSE ; !-} : CREATE.FILE ( n --> ) DOS.FILE ( filespec -$> ) S1 1 SWAP ADDBLKS !.} $DROP ; : S1EDIT ( filespec -$> ) S1 1 EDIT ; !/} -->HEX : RND ( -->!0} n ) D20A C@ ; DECIMAL !1} : SETUP ( filespec -$> ) " D1:SYSTEM.4TH" $SETDR0 DR0 ; !2} SETUP !3} !4} !5} !6} !7} !8} !9} !:} !;} !<} !=} !>} !?} !@} !A} !B} !C} !D} !E} !F} !G} nv ) x( BOOT EDITOR ) HEX ." LOADING EDITOR" CR : TEXT ( --> ) CR FD EMIT %I} PAD 1+ C/L EXPECT C/L 0 DO PAD 1+ I + C@ 0= IF PAD 1+ I + C/L BLANKS LEAVE ENDIF LOOP %J} C/L PAD C! ; : LINE ( N --> ADDR) DUP FFF0 AND 17 ?ERROR %K} SCR @ (LINE) DROP ; : -MOVE LINE C/L CMOVE UPDATE ; --> %L} : H ( N--> ) LINE PAD 1+ C/L DUP PAD C! CMOVE ; : L SCR @ LIST ; %M} : E ( N --> ) LINE C/L BLANKS UPDATE ; DECIMAL %N} : S ( N--> ) DUP 1 - 14 DO I LINE I 1+ -MOVE %O}-1 +LOOP E L ; : D ( N--> ) DUP H 15 DUP ROT DO I 1+ LINE I -%P}MOVE LOOP E L ; --> : "R ( --> ) PAD 1+ SWAP -MOVE ; : P (%Q} N--> ) TEXT "R ; : M ( N--> ) P %R}L ; DECIMAL %S} %T} ." LOADING EDITOR" CR : TEXT ( --> ) CR FD EMIT $$( EDITOR VARIABLES, CONST.. ) HEX 0 VARIABLE EDBUF ( BUF ADDR ) HERE 20 ALLOT CONSTANT EDXLIN)V}E 2F0 CONSTANT CRSINH ( BYTE ) 0 VARIABLE EDROW ( tmp pos) 0 VARIABLE EDCOL 0 VARIABLE EDSCR )W} 0 VARIABLE EDMATCH ( srch flag) 1 VARIABLE EDSSTRT ( srch lim) 100 VARIABLE EDSEND 0 VARIABLE EDOFF ( srch)X} offset) 2 VARIABLE EDKEYLEN ( length) HERE 3A C, 20 C, 8 ALLOT CONSTANT EDKEY ( default ": ") --> )Y} : EDDASHES ( --> ) ." " ." " ; : (EDLINE) ( N --)Z}> ADDR ) DUP 10 = IF DROP EDXLINE ELSE 20 * EDBUF @ + ENDIF ; : EDLINE ( N --> ) DUP 10 = IF 6)[} 12 POS. ELSE 6 OVER 1+ POS. ENDIF 0 SWAP (EDLINE) 20 PUTBUF ; : EDSAVPOS ( --> ) ROWCRS C@ )\}1 - EDROW ! COLCRS @ 6 - EDCOL ! ; : EDRSTPOS ( --> ) EDROW @ 1+ ROWCRS C! EDCOL @)]} 6 + COLCRS ! ; -->: EDLIST ( --> , LIST SCREEN ) SCR @ BLOCK DUP EDBUF ! 7D EMIT 1 CRSINH C! 2 0 POS. SCR )^}@ 3 .R ." " EDDASHES ." " 10 0 DO 2 I 1+ POS. I 2 .R ." |" D)_}UP 20 TYPE 20 + ." |" LOOP DROP 5 11 POS. ." " EDDASHES ." " 5 12 POS. ." |" )`} 26 12 POS. ." |" 5 13 POS. ." " EDDASHES ." " EDXLINE 20 BLANKS )a} 2 14 POS. --> ." EIT BORT OPY RASE EARCH " 0 CRSINH C! 6 1 POS. ; )b} : EDUP ( --> ) ROWCRS C@ 1 - DUP 0= IF DROP 10 ENDIF ROWCRS C! ; : EDDOWN ( --> ) )c} ROWCRS C@ 1+ DUP 11 = IF DROP 1 ENDIF ROWCRS C! ; : EDLEFT ( --> ) COLCRS @ 1 - DUP 5)d} = IF DROP 25 ENDIF COLCRS ! ; : EDRIGHT ( --> ) COLCRS @ 1+ DUP 26 = IF DROP 6 ENDIF)e} COLCRS ! ; --> : EDINSLINE ( --> ) ROWCRS C@ 1 - >R R 1 - F DO I (EDLINE) )f}I 1+ (EDLINE) 20 CMOVE I 1+ EDLINE -1 +LOOP R (EDLINE) 20 BLANKS R EDLINE )g} 6 R> 1+ POS. UPDATE ; : EDDELLINE ( --> ) ROWCRS C@ 1 - >R 10 R DO I 1+ )q}3B'DOS SYSB*+DUP SYSBUAUTORUN SYSBWINTRFACEIN0BXMX80 IN1Bw^FORTHD1BIN2B=FORTHD1 INZB DOS 4THB)DISK 4THB HBOOTEDIT4THB_UEDITOR 4THB2FORMAT 4THB)SEARCH 4THBcSYSTEM 4THB {TURNKEY 4THBUTILITY 4THDISK CATMACE DSK(EDLINE) I (EDLINE) 20 CMOVE I EDLINE LOOP EDXLINE 20 BLANKS 10 EDLINE 6 R> 1+ POS. UPD)r}ATE ; --> : EDCHAR ( KEY --> KEY ) DUP COLCRS @ >R R 6 - )s}ROWCRS C@ >R R 1 - >R R (EDLINE) + C! R> EDLINE R> R> SWAP POS. EDRIGHT UPDATE ; )t} : EDRET ( --> ) 6 COLCRS C! EDDOWN ; : EDIGNORE ( --> ) ; )u} : EDBS ( --> ) COLCRS @ 6 > IF EDLEFT 20 EDCHAR DROP )v} EDLEFT UPDATE ENDIF ; --> : EDINSCHAR ( --> ) ROWCRS C@ 1 - COLCR)w}S @ 6 - OVER (EDLINE) DUP 1F + C@ BL - IF BELL DROP DROP DROP ELSE OVER 1 - OVER + OVER 1E + DO I C@ I 1+ C! )x}-1 +LOOP DROP 6 + COLCRS ! 1+ ROWCRS C! BL EDCHAR DROP EDLEFT ENDIF ; : EDDELCHAR ( --> ) ROWCRS C@ 1 - )y} COLCRS @ 6 - OVER (EDLINE) OVER OVER + DUP 1+ SWAP 1F 5 PICK - CMOVE 1F + BL SWAP C! OVER EDLINE 6 + COLCRS )z}! 1+ ROWCRS C! UPDATE ; --> ( EDSCREEN KEY --> KEY ) :SELECT E){}DSCREEN 1C EDUP 1D EDDOWN 1E EDLEFT 1F EDRIGHT 7E EDBS 9B EDRET 9C EDDELLINE 9D EDINSLINE FE ED)|}DELCHAR FF EDINSCHAR 7D EDIGNORE 7F EDIGNORE 9E EDIGNORE 9F)}} EDIGNORE FD EDIGNORE 0 EDCHAR ; )~} --> : EDEXIT ( KEY --> T ) )} DROP 7D EMIT FLUSH 1 ; : EDABORT ( KEY --> T ) PREV @ @ 7FFF AND PREV @)} ! EDEXIT ; : EDNEXT ( COL ROW KEY --> COL ROW F ) )} DROP DROP DROP 1 SCR +! EDLIST 6 1 0 ; : EDPREV ( COL ROW K)}EY --> COL ROW F ) DROP DROP DROP -1 SCR +! EDLIST 6 1 0 ; -->: EDERASE ( COL R)}OW KEY --> COL ROW F ) DROP DROP DROP 0 (EDLINE) B/BUF BLANKS EDXLINE C/L B)}LANKS 10 0 DO I EDLINE LOOP UPDATE 6 1 0 ; )} )} --> : EDP)}UTDIG ( ADDR KEY --> ADDR TF ) DUP 7E = IF DROP DUP PAD > )}IF SPACE 7E EMIT 7E EMIT 1 - ELSE BELL ENDIF 0 ELSE DUP 9B = IF DROP 1 )} ELSE DUP EMIT DUP 30 < OVER 39 > OR IF DROP BELL 1E EMIT 0 )} ELSE OVER ! 1+ 0 ENDIF ENDIF ENDIF ; --> )} : EDGETNUM ( KEY --> VALUE TF ) DUP IF PAD SWAP EDPUTDIG ELSE DROP PAD 0 ENDIF)} 0= IF BEGIN (KEY) EDPUTDIG UNTIL ENDIF DUP PAD = )} IF DROP 0 0 ELSE 0 SWAP PAD DO 0A * I C@ 30 - + LOOP 1 ENDIF ; )} --> )} : EDNEW ( COL ROW KEY --> COL ROW F ) 2 17 POS. ." screen: " EDGETNUM )} IF SCR ! EDLIST DROP DROP 6 1 ELSE DROP 2 17 POS. 10 SPACES ENDIF )}0 ; )} -)}-> : EDCOPY ( COL ROW KEY --> COL ROW F ) DROP SCR @ 2 17 POS. ." from:)}" 0 EDGETNUM OVER 0 > AND IF 0B 17 POS. ." to:" 0 EDGETNUM OVER 0 > AND IF 12 17 POS. ." screens:)}" 0 EDGETNUM OVER 0 > AND IF 3 PICK 3 PICK > IF 0 DO OVER I + BLOCK )} OVER I + OFFSET @ + BUFFER B/BUF CMOVE UPDATE LOOP ELSE >R R + 1 - SWAP )}R + 1 - SWAP R> 0 DO --> OVER I - BLOCK OVER I - OFFSET @ + BUFFER B/BUF CMOVE )}UPDATE LOOP ENDIF DROP DROP FLUSH ELSE DROP DROP DROP ENDIF ELSE DROP DROP ENDIF ELSE DROP END)}IF SCR ! EDLIST 0 ; )} )} --> ( EDMENUSEL, COL ROW KEY --> COL ROW TF ) )} : EDSEARCH DROP 0 ; )} :SELECT EDMENUSEL 58 EDEXIT 41 EDABORT 43 EDCOPY 45 EDERASE )} 53 EDSEARCH 3E EDNEXT 3C EDPREV 0 EDNEW ; )} --> : EDMENU ( --> TF ) COLCRS @ ROWCRS C@ )} 2 17 POS. ." enter command:" (KEY) 2 17 POS. 10 SPACES EDMENUSEL >R R IF DROP DROP ELSE PO)}S. ENDIF R> ; )} )} --> : EDIT ( N --> ) PRFLAG @ 0 PR)}FLAG ! ( prt off) DECIMAL 0 GR. SWAP SCR ! EDLIST BEGIN BEGIN 0 9)}E PUT ( MOVE CRS ) KEY DUP 1B - ( UNTIL ESCAPE ) WHILE 1 CRSINH C! EDSCREEN DROP 0 CRS)}INH C! REPEAT DROP EDMENU ( MENU MODE ) UNTIL PRFLAG ! ( prt on) ; )} DECIMAL -->HEX : ADDBLKS ( 0/1 n --> ) ()} add number of blocks to DR0 or DR1 ) SWAP FLUSH IF CLOSE-DR1 #3 9 0 DR1NAME )} ELSE CLOSE-DR0 #3 9 0 DR0NAME ENDIF OPEN ?DISKERROR 1 BUFFER DUP 200 BLANKS SWAP 0 DO )} #3 OVER 200 PUTBUF ?DISKERROR LOOP DROP #3 CLOSE EMPTY-BUFFERS ; )} DECIMAL )} )} )} )} : ?MATCH ()} addr1 addr2 len --> sets EDMATCH) 1 EDMATCH ! ( assume match) 0 DO OVER )}I + C@ OVER I + C@ = 0= IF ( no match?) 0 EDMATCH ! ( reset flag) LEAVE ENDIF LOO)}P DROP DROP ; )} -)}->: EDSEARCH ( -->, forward) SCR @ EDSCR ! EDSAVPOS EDROW @ C/L * EDCOL + EDOFF ! 0 EDMATCH ! ( indicate no)} mat) ?TERMINAL DROP ( clear BREAK) BEGIN ( loop until match,limit) ?TERMINAL 0= ( or BREAK) EDMATCH @ 0= OR )} WHILE 1 EDOFF +! ( move forward) EDOFF @ B/BUF = ( end of scr?) IF )} SCR @ EDSEND @ < IF ( not yet at END) 1 SCR +! ( move to new scr) EDLIST -1 EDO)}FF ! --> ELSE ( limit reached) -1 EDMATCH ! ENDIF ELSE ( check )}for key match) EDKEY EDBUF @ EDOFF @ + EDKEYLEN @ ?MATCH ENDIF REPEAT )} EDMATCH @ 0 > IF ( match found) EDOFF @ C/L /MOD EDROW ! EDCOL !)} ELSE ( no match, return) EDSCR @ SCR ! EDLIST 2 16 ." Search failed" ENDIF)} EDRSTPOS ; . ) HEX 0 VARIABLE EDBUF ( BUF ADDR ) HERE 20 ALLOT CONSTANT EDXLIN(( FORMAT file -$> reads file and copies to screen or printer. The file has lines with commands: -} .BREAK pause on screen .CENTER text center text .END end of file .FILL begin fill-}ing .NOFILL end filling .PAGE start new page . blank line ) -} -} -->( variables ) 0 VARIABLE F-PRFLAG ( printer?) 0 VARIABLE F-WIDTH 0 VARIABLE F-FORM-}FEED 0 VARIABLE F-ENDFLAG 0 VARIABLE F-FILLFLAG 0 VARIABLE F-T1 ( temp vars) 0 VARIABLE F-T-}2 0 VARIABLE F-WORDS ( # on line) 135 $VARIABLE F-LINE$ 135 $VARIABLE F-TEMP$ C/L $VARIAB-}LE F-INP$ ( inp line)HEX 9B CONSTANT EOL DECIMAL : EOLSND-} #4 EOL PUT ; -->: F-OUTFILL ( -->, out filled) F-WIDTH @ F-LINE$ $VARLEN - F-T1 ! ( # of spaces to add) F-LI-}NE$ 0 BL $EXTRACT DROP F-TEMP$ $! -1 F-WORDS +! ( cnt) BEGIN ( move word at a time) F-WORDS @ 0 > WHILE -}F-T1 @ F-WORDS @ 1 - + F-WORDS @ / ( # of spaces) DUP MINUS F-T1 +! ( adj cnt) 1+ 0 DO " " F-TEMP$ $+! LOOP-} F-LINE$ SWAP BL $EXTRACT DROP F-TEMP$ $+! ( add wd ) -1 F-WORDS +! REPEAT DROP #4 F-TEMP$ F-WIDTH @ PUTBUF-} EOLSND "" F-LINE$ $! ; -->: F-FILL-LINE ( addr --> ) C/L $FETCH F-INP$ $! 0 ( offset in line) -} BEGIN ( move word at a time) F-INP$ SWAP BL $EXTRACT WHILE $LEN IF ( non-empty word) F-WIDTH @ F-LINE$ $-}VARLEN - $LEN 1+ < ( line full?) IF F-OUTFILL ENDIF ( flush) F-LINE$ $VARLEN 0 > IF " " F-LINE$ $+-}! ENDIF ( add space) F-LINE$ $+! ( add wd) 1 F-WORDS +! ( inc count) ELSE $DROP ( 0-} len wd) ENDIF REPEAT ; -->: F-NOFILL-LINE ( addr --> ) #4 SWAP C/L PUTBUF EOLSND ; : F-ENDFILL (-} --> ) F-FILLFLAG @ IF ( filling?) F-WORDS @ IF ( ln not empty?) #4 F-LINE$ F-LINE$ $VARLEN PUTBUF E-}OLSND ENDIF ENDIF "" F-LINE$ $! 0 F-WORDS ! ; : F-ERROR ( addr char --> ) DROP 1 - CR C/L TYPE 1 F-EN-}DFLAG ! ; : F-BREAK ( addr char --> ) F-PRFLAG @ 0= IF ( scr) 2 23 POS. ." " KEY-} DROP 125 EMIT ( clr scr) ENDIF DROP DROP ; -->: F-CENTER ( addr char --> ) DROP ( find 1st non-bl char) -}0 F-T1 ! ( 1st non-bl addr) 0 F-T2 ! ( last non-bl addr) DUP C/L + -1 + SWAP DO ( loop through line) -} F-T2 @ 0= IF ( past .CENTER?) I C@ BL = ( blank?) IF 0 F-T1 ! 1 F-T2 +! ENDIF ELSE -} F-T1 @ 0= IF ( looking for 1st non-bl?) I C@ BL = 0= ( non-bl?) IF I F-T1 ! ENDIF -} ENDIF --> I C@ BL = 0= ( last non-bl?) IF I F-T2 ! ENDIF -} ENDIF LOOP F-T2 @ ( non-empty text?) IF ( then center -}text) F-WIDTH @ F-T2 @ F-T1 @ - 1+ - 2 / ( # of blanks) -DUP IF 0 DO #4 BL P-}UT LOOP ENDIF #4 F-T1 @ F-T2 @ OVER - 1+ PUTBUF ( output text) EOLSND -} ENDIF ; -->: F-END ( addr char --> ) DROP DRO-}P 1 F-ENDFLAG ! ; : F-FILL ( addr char --> ) DROP DROP 1 F-FILLFLAG ! ; : F-NOFILL ( addr char --> ) DROP -}DROP 0 F-FILLFLAG ! ; : F-PAGE ( addr char --> ) F-PRFLAG @ IF ( printer) DROP DROP F-FORMFEED @ IF -}#4 12 PUT ( form-feed) EOLSND ELSE ( 5 blank lines ) 5 0 DO EOLSND LOOP ENDIF ELSE F-BREAK ( screen) -} ENDIF ; : F-DOT ( addr char --> ) DROP DROP EOLSND ; -->( F-DOCMD addr char --> ) -} :SELECT F-DOCMD 66 F-BREAK 67 F-CENTER 69 F-END -} 70 F-FILL 78 F-NOFILL 80 F-PAGE 32 F-DOT -} 0 F-ERROR ; : F-PROCESS-CMD ( addr --> ) F-ENDFILL 1+ DUP C@-} F-DOCMD ; -->: F-PROCESS-LINE -}( --> ) #3 PAD C/L GETBUF ?DISKERROR DROP ( assume C/L) PAD DUP C@ 46 = ( 1st ch "."?) IF F-PROCESS--}CMD ELSE F-FILLFLAG @ ( filling?) IF F-FILL-LINE ELSE F-NOFILL-LINE ENDIF ENDI-}F ; -} --> : FOR-}MAT ( file -$> ) #3 CLOSE #4 CLOSE #3 4 0 $FILE OPEN $DROP ?DISKERROR C-}R ." Use printer (Y/N)? " KEY 89 ( Y) = DUP F-PRFLAG ! IF " P:" ELSE " E:" ENDIF #4 8 0 $FILE OPEN $DROP -} F-PRFLAG @ IF CR ." Line width? " 2 PAD C! PAD 1+ 2 EXPECT BL PAD 3 + C! PAD NUMBER -}DROP F-WIDTH ! CR ." Printer has form-feeds " ." (Y/N)? " KEY 89 ( Y) = F-FORMFEED ! -} --> ELSE 37 F-WIDTH ! ENDIF ( reset variables) 1 F-FILLFLAG ! -} 0 F-ENDFLAG ! "" F-LINE$ $! 0 F-WORDS ! BEGIN ( 1 line at -}a time) F-PROCESS-LINE F-ENDFLAG @ ( until end) ?TERMINAL OR ( or break key) UNTIL -} #3 CLOSE ?DISKERROR #4 CLOSE ; -} reads file and copies to screen or printer. The file has lines with commands: ,( Binary search routines ) 0 VARIABLE ADDR 0 VARIABLE LAST-ADDR 0 VARIABLE LAST-BYTE 1} 0 VARIABLE NEW-BYTE 0 VARIABLE BYTE1 0 VARIABLE BYTE2 1} 1} 1} -->: ?NOT-EOF (STAT) @ 127 > IF #3 CLOSE ." END" CR QUIT ENDIF ; 1} : START-NEW-RECORD ( --> ) #3 GET ADDR C! ?NOT-EOF #3 GET ?DISKERROR ADDR 1+ C! ADDR @ 1+ 0=1} ( skip FFFF) IF #3 GET ?DISKERROR ADDR C! #3 GET ?DISKERROR ADDR 1+ C! ENDIF -1 ADDR +1}! #3 GET ?DISKERROR LAST-ADDR C! #3 GET ?DISKERROR LAST-ADDR 1+ C! -1 NEW-BYTE ! ; 1} -->: GET-NEXT-BYTE ( --> ) 1 ADDR +! ADDR @ LAST-ADDR @ > IF 1}START-NEW-RECORD ENDIF NEW-BYTE @ LAST-BYTE ! #3 GET NEW-BYTE ! ?DISKERROR ; : 1}FOUND-MATCH ( --> ) ." MATCH: " ADDR @ U. CR ; 1} 1} -->: DO-SEARCH ( --> , $ -$> ) #3 4 0 $FILE OPEN $DROP ?DISKERROR 1} START-NEW-RECORD CR HEX BEGIN GET-NEXT-BYTE BYTE2 @ 0< IF BYTE1 @ NEW-BYTE @ 1}= IF FOUND-MATCH ENDIF ELSE BYTE1 @ NEW-BYTE @ = BYTE2 @ LAST-BYT1}E @ = AND IF FOUND-MATCH ENDIF ENDIF 0 UNTIL ; 1} -->: BSRCH ( byte $ --> ) BYTE1 ! -1 BYTE2 ! DO-SEARCH ; : WSRCH ( wor2}d $ --> ) ADDR ! ADDR C@ BYTE2 ! ADDR 1+ C@ BYTE1 ! DO-SEARCH ; 2} 2} 2} 2} 2} 2} 2} 2} 2 } 2 } 2 } 2 } 2 } 2} 2} 2} 2} 2} 2} 2} 2} 2} 2} 0x( basic functions ) HEX : BELL FD EMIT ; DECIMAL : FREE ( amount of memory lef6}t) MEMTOP @ PAD 256 + - ; : U. 0 D. ; ( unsigned . ) : NEW-ABORT ( auto-reset ) HERE 2 - ' ABORT DUP @ , 6}! ; IMMEDIATE 512 VARIABLE *$* ( $STK size) 6} --> 6} ( printer routines ) HEX CREATE (P:) 50 C, 3A C, 9B C, SMUDGE ' (P:) CONSTANT P: : PR-ON 70 CLOSE 6}70 8 0 P: OPEN 1 PRFLAG ! ; : PR-OFF 70 CLOSE 0 PRFLAG ! ; : PLIST ( strt end --> ) 1+ SWAP C EMI6}T ( form-feed) CR DO CR I LIST CR CR CR ?TERMINAL IF LEAVE ENDIF LOOP C EMIT CR ; 6} 6 } -->HEX : :SELECT ( code --> ? ) DUP DUP C@ 3 * + 1+ SWAP 1+ DO I C@ DUP 0= IF DROP 6#} I 1+ @ EXECUTE LEAVE ELSE OVER = IF I 1+ @ EXECUTE LEAVE ENDIF ENDIF 3 +LOOP ; 6$} 6 LOAD( ERROR MESSAGES ) EMPTY STACK DICTIONARY FULL 6%} HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISK RANGE ? 6&} FULL STACK DISK ERROR ! 6'} 6(} FORTH INTEREST GROUP ( ERROR MESSAGES ) COMPILATION ONLY, USE IN DEFN EXECUTION ONL6)}Y CONDITIONALS NOT PAIRED DEFINITION NOT FINISHED IN PROTECTED DICTIONARY USE ONLY W6*}HEN LOADING OFF CURRENT EDITING SCREEN DECLARE VOCABULARY 6+} 6,} : DUMP ( from number --> ) BASE @ >R HEX ( save base) 6-}0 DO CR DUP I + DUP 0 4 D.R ." :" 8 0 DO ( 8 byte values) DUP I + C@ 2 .R SPACE LOOP 1 2FE C! ( display controls)6.} 8 0 DO ( print ASCII) DUP I + C@ EMIT LOOP ?TERMINAL IF LEAVE ENDIF 0 2FE C! DROP 8 +LOOP 6/} DROP CR R> BASE ! ; : ,hi-lo) -DUP IF 1 - -1 SWAP DO OVER I + C@ OVER I + C60}! -1 +LOOP ENDIF DROP DROP ; -->( I/O definitions ) 00 CONSTANT #0 30 C61}ONSTANT #3 40 CONSTANT #4 50 CONSTANT #5 60 CONSTANT #6 2FB CONSTANT ATACHR 54 CONSTANT ROWCRS62} ( 1 byte) 55 CONSTANT COLCRS ( 2 bytes) 63} 64} 0 VARIABLE (COLOR) -->: ?IOERR (STAT) @ 7F > IF BASE @ H65}EX HERE COUNT TYPE ." ? I/O ERROR " (STAT) @ . BASE ! SP! IN @ BLK @ QUIT ENDIF ; CREATE66} (S:) 53 C, 3A C, 9B C, SMUDGE ' (S:) CONSTANT S: CREATE (E:) 45 C, 3A C, 9B C, SMUDGE ' (E:) CONSTANT E: : G67}R. ( mode --> ) ( mode+16=split,mode+32=no clr) #6 CLOSE #0 CLOSE #0 C 0 E: OPEN 68} #6 SWAP DUP 30 AND C OR ( aux1) SWAP S: OPEN ?IOERR ; -->: POS. ( x y --> ) 69} ROWCRS C! COLCRS ! ; : COLOR ( col --> ) (COLOR) C! ; : DR. ( x y --> ) 6:} (COLOR) C@ ATACHR C! POS. #6 11 JSRCIO ; : LOC. ( x y --> val ) OVER OVER POS. #6 GET6;} >R POS. #6 R PUT R> ; : PL. ( x y --> ) POS. #6 (COLOR) C@ PUT ; : SE. ( reg hue lum 6<}--> ) SWAP 10 * + SWAP 2C4 + C! ; : STICK ( port --> value) 278 ( STICK0) + C@ ; -->CREATE (CVTSTK) 46=} C, 2 C, 3 C, FF C, 6 C, 8 C, 7 C, FF C, 5 C, 1 C, 0 C, SMUDGE : CVTSTK ( value --> 0=nothing, 1=up, 3=right6>}, 5=down, 7=left) 5 - ' (CVTSTK) + C@ ; : STRIG ( port --> TF,T=not psh) 284 ( STRIG0) + C@ ; : SO. ( voi6?}ce pitch dist vol ->) 3 D20F C! 3 232 C! 0 D208 C! SWAP 10 * + 3 PICK DUP + D201 ( AUDC1) + C! SWAP DU6@}P + D200 ( AUDF1) + C! ; -->: SPE6A}MIT ( char -->,special ch) 1 2FE C! EMIT 0 2FE C! ; : XIO ( cmd iocb aux1 aux2 nameaddr --> ) 46B} PICK >R ( iocb --> ret stk) R 344 + ! ( store name addr) R 34B + C! ( store aux2) R> 34A + C! ( store aux1) 6C} SWAP JSRCIO ( do cmd) ; 6D} DECIMAL 6E} -->( string definitions) HEX *$* @ ALLOT ( allocate $STK) HERE CONSTANT $0 ( $STK base) $0 VARIABLE $P ( $STK 6F}pointer) : $P! ( --> , reset $STK) $0 $P ! ; : $P@ ( --> $P value) $P @ ; 6G} : $DROP ( $ -$> ) $P@ DUP C@ + 1+ $P ! ; : $LEN ( --> len of top $ ) $P@ C@ ; 6H} : $FETCH ( addr len --> , -$> $) $P@ OVER 1+ - DUP $P ! ( upd$P) OVER OVER C! ( store len) 1+ SWAP CMOV6I}E ( move str) ; -->: $STORE ( addr max --> actual, $ -$> ) $LEN MIN >R ( actual length) $P@ 1+ SW6J}AP R CMOVE R> $DROP ; : $VARLEN ( vaddr --> len ) 1 - C@ ; : $VARM6K}AX ( vaddr --> max len ) 2 - C@ ; : $@ ( vaddr -->, -$> $ ) DUP $VARLEN $FETCH ; : $!6L} ( vaddr -->, $ -$> ) DUP DUP $VARMAX $STORE SWAP 1 - C! ; : $. ( $ -$> , print string) 6M}$P@ 1+ $LEN TYPE $DROP ; -->: $DUP ( $ -$> $ $ ) $P@ 1+ $LEN $FETCH ; : $P2@ ( 2nd$P) $P@ $LEN + 1+ 6N}; : $LEN2 ( 2ndlen) $P2@ C@ ; : $OVER ( $1 $2 -$> $1 $2 $1 ) $P2@ 1+ $LEN2 $FETCH ; : $SWAP ( $1 $2 -$> $2 $1 )6O} $P@ >R $LEN ( $2 length) $OVER $LEN + 2+ ( $1$2$1, len) $P@ SWAP R SWAP $P ! ; ( pop extra $6P}1) : $+ ( $1 $2 -$> $1+$2 ) $SWAP $LEN2 $LEN + $P@ 1+ DUP 1+ $LEN : $FILL ( n b -->, -$> n b's ) OVER 1+ $P@ SWAP - DUP $P ! ( alloc space ) 6R} 3 PICK OVER C! ( store length) 1+ ROT ROT FILL ; : $VARFILL ( vaddr b --> ) OVER DUP $VARM6S}AX SWAP $VARLEN - -DUP IF ( any left to fill?) >R OVER $@ R> SWAP $FILL $+ $! ELSE DROP D6T}ROP ENDIF ; : $VARIABLE ( len -->) 2+ ; : (") ( m6U}ove inline str to $STK) R 1+ $@ R C@ R> + 1+ >R ; -->: " ( if comp, put inline str on $STK in exec, else put now) STATE6V} @ IF COMPILE (") 22 WORD HERE C@ 1+ ALLOT ELSE 22 WORD HERE 1+ $@ ENDIF ; IMMEDIATE 1 $6W}VARIABLE $EOL ( EOL string) $EOL 9B $VARFILL : $FILE ( --> addr, $ -$> $+EOL) $EOL $@ $+ $P@ 1+ ; 6X}: $SETDR0 ( --> , $ -$> ) FLUSH CLOSE-DR0 $FILE DROP DR0NAME 10 $STORE DROP ; : $SETDR1 ( --> , $ -$> ) 6Y} FLUSH CLOSE-DR1 $FILE DROP DR1NAME 10 $STORE DROP ; -->0 VARIABLE $TR ( temp result) : ($COMPARE) ( addr1 addr26Z} len --> 1,0,-1 ) 0 $TR ! -DUP IF ( len>0?) 0 DO OVER I + C@ OVER I + C@ - -DUP IF ( no match6[}?) 0< IF -1 ELSE 1 ENDIF $TR ! LEAVE ENDIF LOOP ENDIF DROP DROP $TR @ ; : ($BLCOMPARE) ( add6\}r len --> 1,0,-1 compare to blanks) 0 $TR ! -DUP IF ( len>0?) 0 DO DUP I + C@ BL - -DUP IF 0< IF -1 ELSE 6]}1 ENDIF $TR ! LEAVE ENDIF LOOP ENDIF DROP $TR @ ; -->: $COMPARE ( --> 1,0,-1 $1 $2 -$> , 6^}compare two str) $P2@ 1+ $P@ 1+ $LEN $LEN2 MIN ($COMPARE) DUP 0= ( match?) IF ( ck rest of str) $LEN $LEN6_}2 < IF ( $1 longer?) DROP $P2@ 1+ $LEN + $LEN2 $LEN - ($BLCOMPARE) ELSE DROP $P@ 1+ $LEN2 + $LEN $LEN26`} - ($BLCOMPARE) MINUS ENDIF ENDIF $DROP $DROP ; : $= ( --> tf, $1 $2 -$> ) $COMPARE 0= ; : $< 6a}( --> tf, $1 $2 -$> ) $COMPARE 0< ; DECIMAL -->: "" ( push empty str on $STK) -6b}1 $P +! 0 $P@ C! ; 0 VARIABLE $TO ( offset) 0 VARIABLE $TL ( length) : $EXTRACT ( varaddr off char 6c} --> t offset -$> word --> f [when no word left] ) $TR ! ( store char) -1 $TO ! 0 $TL ! ( clr off,6d}len) OVER $VARLEN OVER OVER < IF ( still room left in var) SWAP DO ( find 1st non-separ) DUP I + C@ $TR @ = 0= 6e} IF ( non-separator char) I $TO ! ( starting offset) --> I 1+ OVER $VARLEN 6f}OVER OVER < IF ( not at end of var) SWAP DO ( find next separ) DUP I + C@ $TR @ = IF ( found en6g}d of word) I $TO @ - $TL ! ( length) LEAVE ENDIF LOOP $TL @ 0= IF ( assume6h} end of line) DUP $VARLEN $TO @ - $TL ! ( length to end) ENDIF ELSE ( 1 6i}char at end of var) 1 $TL ! DROP DROP ENDIF LEAVE --> ENDIF 6j} LOOP ELSE DROP DROP ENDIF $TO @ 6k}0< IF ( word not found) DROP 0 ( return FALSE) ELSE ( word was found) $TO @ + $TL @ $FETCH ( get wd) $T6l}O @ $TL @ + ( new offset) 1 ( return TRUE) ENDIF ; 6m} -6n}->: $+! ( var --> , $ -$>, add str to variable ) ( comp. new len) >R R $VARLEN R + ( start addr) R $VARMAX R $VARLEN - ( ch6o} lft) $STORE ( concat, ret len added) R $VARLEN + R> 1 - C! ( store new length) ; : $RESET ( auto-$STK res6p}et) NEW-ABORT $P! DECIMAL ; 6q} 6r} -->: $LOAD ( filename -$> ) $SETDR1 DR1 1 LOAD ; : LOAD-ED " D:EDITOR.4TH6s}" $LOAD ; : LOAD-BED ( boot editor) " D:BOOTEDIT.4TH" $LOAD ; : LOAD-DOS " D:DOS.4TH6t}" $LOAD ; : LOAD-TURN " D:TURNKEY.4TH" $LOAD ; 6u} 6v} 6w} 6x} 6y} 6z} BELL FD EMIT ; DECIMAL : FREE ( amount of memory lef4&HEX : TURNKEY ( filename -$> ) ' FORTH 4 + @ C +ORIGIN ! HERE 1C +ORIGIN ! HERE 1E +ORIGIN ! :|} #3 8 0 $FILE OPEN $DROP ?DISKERROR #3 FF PUT ?DISKERROR ( header) #3 FF PUT ?DISKERROR :}} DR0NAME 10 - PAD ! ( load addr) :~} --> :} #3 PAD 2 PUTBUF ( load addr) ?DISKERROR #3 DP 2 PUTBUF ( end addr) ?DISKERROR :} #3 PAD @ ( load rec.) DP @ OVER - 1+ PUTBUF ?DISKERROR #3 E0 PUT ?DI:}SKERROR ( run ) #3 02 PUT ?DISKERROR ( addr ) #3 E1 PUT ?DISKERROR #3 02 PUT ?DISKERROR 0 +ORIGIN :} PAD ! ( store addr) #3 PAD 2 PUTBUF ?DISKERROR #3 CLOSE ?DISKERROR ; DECIMAL :} -$> ) ' FORTH 4 + @ C +ORIGIN ! HERE 1C +ORIGIN ! HERE 1E +ORIGIN ! 8( Utilities ) : NEW ( use NEW FORTH ) " D:*.IN2,*.INZ" RENAME " D:*.INZ" LOCK >} " D:*.INY,*.IN2" RENAME ; : OLD ( use OLD FORTH ) " D:*.INZ" UNLOCK " D:*.IN2,*.INY" RENAME >} " D:*.INZ,*.IN2" RENAME ; --> >} >} ( DECOMPILER BY DAVID MANN AACE)DECIMAL : U.R 0 SWAP D.R ; : NOT 0= ; >} : GETPFA [COMPILE] ' ; ' QUIT CFA @ CONSTANT DOCOL : ?COLONDEF DUP CFA @ DOCOL = NOT 30 ?ERRO>}R CR ." : DEFINITION" ; : PFA->ID. DUP 8 U.R DUP @ DUP 8 U.R 2 SPACES DUP 560 < OVER LATEST PFA >}CFA > OR IF . ELSE 2+ NFA ID. THEN CR ; >} --> : ?;CODE DUP @ ' (;CODE) CFA = ; : ?;S DUP @ ' ;S CFA = ; : ?; ( PFA --- -FA F ) >R R @ ' (;CO>}DE) CFA = R @ ' ;S CFA = OR R> SWAP ; : ;: ( ;: NAME - ) GETPFA ?COLONDEF CR BEGIN PFA->ID. ?; ?>}TERMINAL OR NOT WHILE 2+ REPEAT DROP ; >} >} >} >} >} >} >} >} >} >} >} >} >} >} N2,*.INZ" RENAME " D:*.INZ" LOCK <HD:DISK.CATXA D:PROGLIBNDESTYPSRCDATSECXINSVPLSNISSSEOSEBYGHRSMENTSCR@ D:MACE.DSKCBBB DISK.CAT 001DB HELLO AUTOBOOT FILE UTIL 8 D